unit TextRotate;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, 
  Controls, Forms, Dialogs, ExtCtrls;

type
  TTextRotate = class(TPaintBox)
  private
    Fdx,Fdy:integer;
    FAngle:integer;
    FText :String;

    function GetDX: integer;
    function GetDY: integer;
    function GetAngle: integer;
    function GetText: String;

    procedure SetDX(const Value: integer);
    procedure SetDY(const Value: integer);
    procedure SetAngle(const Value: integer);
    procedure SetText(const Value: String);

    { Private declarations }

  protected
     procedure OnPaintText(Sender: TObject);
    { Protected declarations }

  public
     constructor Create(AOwner:TComponent); override;
    { Public declarations }

  published
     property dx:integer 
                       read GetDX write SetDX;
     property dy:integer 
                       read GetDY write SetDY;
     property Angle:integer 
                       read GetAngle write SetAngle;
     property Text:String 
                       read GetText write SetText;

    { Published declarations }
  end;

procedure Register;

implementation

procedure RotateText(Canvas:TCanvas;  
                                          X,Y:Integer;      
                                          Text:PChar;      
                                          Angle:integer);    
var

LogRec: TLOGFONT;    
OldFont,                     
NewFont: HFONT;

begin
     GetObject(Canvas.Font.Handle, SizeOf(LogRec),
                                                                                        @LogRec);
     LogRec.lfEscapement := Angle*10;
     LogRec.lfOutPrecision := OUT_TT_ONLY_PRECIS;


     NewFont := CreateFontIndirect(LogRec);

     OldFont := SelectObject(Canvas.Handle,NewFont);

     Canvas.TextOut(X, Y, Text);

     NewFont :=SelectObject(Canvas.Handle, OldFont);

     DeleteObject(NewFont);
end;


constructor TTextRotate.Create(AOwner: TComponent);
begin
  inherited;
  Fdx:=width div 2; 
  Fdy:=height div 2;    
  FText:='RotateText';
  FAngle:=30;
  Self.Onpaint:=OnPaintText;

end;


function TTextRotate.GetDY: integer;
begin
  result:=Fdy;
end;

procedure TTextRotate.SetDY(const Value: integer);
begin
  if Fdy <> Value then begin
     Fdy:=Value;
     Repaint;
  end;
end;

function TTextRotate.GetDX: integer;
begin
  result:=Fdx;
end;

procedure TTextRotate.SetDX(const Value: integer);
begin
  if Fdx <> Value then begin
     Fdx:=Value;
     Repaint;      
  end;
end;


function TTextRotate.GetText: String;
begin
  result:=FText;
end;

procedure TTextRotate.SetText(const Value: String);
begin
  if FText<>Value then 
  begin
        FText:=Value;
        Repaint;
  end;
end;

function TTextRotate.GetAngle:Integer;
begin
  result:=FAngle;
end;

procedure TTextRotate.SetAngle(const Value: integer);
begin
  if FAngle<>Value then 
  begin
       FAngle:=Value;
       Repaint;
  end;
end;


procedure TTextRotate.OnPaintText(Sender: TObject);
begin
   RotateText(self.canvas,Fdx,Fdy,PChar(FText),FAngle);
end;

procedure Register;
begin
  RegisterComponents('Samples', [TTextRotate]);
end;

end.
